signature COLOR =
sig
	structure Frame : FRAME

	type allocation = Frame.register Temp.Table.table

	val color : {interference : Liveness.igraph,
		     initial      : allocation,
		     spillCost    : Graph.node -> int,
		     registers    : Frame.register list} -> allocation * Temp.temp list
end

structure Color : COLOR =
struct 
  structure E = ErrorMsg
  structure F = MipsFrame
  structure G = Graph
  structure GB = G.Table
  structure L = Liveness
  structure M = Temp
  structure MB = M.Table

  structure LST = List
  structure OPT = Option
		

  type allocation = F.register MB.table

  fun color {interference=L.IGRAPH{graph, tnode, gtemp, moves},
	     initial,
	     spillCost,
	     registers} =

      let val numRegs = length registers
	  val nodes = G.nodes graph
	  val adjTable = foldr (fn (n, t) => GB.enter (t, n, G.adj n))
			       GB.empty
			       nodes

	  val stack =
	      let val stack = ref []
			      
		  val worklist = ref (foldr (fn (n, ns) => if (length (G.adj n) <= numRegs)
							   then n::ns
							   else ns)
					    []
					    nodes)
				 
		  fun simplify () = case !worklist
				     of []      => ()
				      | (n::ns) => ( worklist := ns
						   ; stack := (n::(!stack))
						   ; app (fn n' => ( G.rm_edge {from=n,  to=n'}
								     handle GraphEdge => ()
								   ; G.rm_edge {from=n', to=n }
								     handle GraphEdge => ()
								   ; if length (G.adj n') = numRegs
		      						     then worklist := !worklist @ [n']
								     else ()
								   ))
							 (G.adj n)
						   )
						   
	      in ( while (not (null (!worklist))) do
		       simplify ()
		 ; !stack
		 )
	      end

	  val coloring = let val colorTable = ref initial
			     fun assignOne n = case MB.look (!colorTable, gtemp n) of
					 SOME reg => () (* precolored *)
				       | NONE => let val adjNodes = case GB.look (adjTable, n)
								     of NONE    => E.impossible ("COLOR: ADJ MISSING NODE" ^ (G.nodename n))
								      | SOME ns => ns

						     val adjacentRegisters = foldr (fn (n, cs) => case MB.look (!colorTable, gtemp n)
												   of NONE   => cs
												    | SOME c => c::cs)
										   []
										   adjNodes

						     val availableRegisters = LST.filter (fn reg => LST.all (fn reg' => reg <> reg')
													    adjacentRegisters)
											 registers

						 in case availableRegisters
						     of [] => E.impossible "NOT ENOUGH REGISTERS: NEED COALESCING OR SPILLING"
						      | (reg::regs) => colorTable := MB.enter (!colorTable, gtemp n, reg)
						 end
			 in ( app assignOne stack
			    ; !colorTable
			    )
			 end
      in (coloring, [])
      end

      structure Frame = F
end
